home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / pgm_ing / custprop / custprop.bas next >
BASIC Source File  |  1995-09-15  |  3KB  |  150 lines
  1. Option Explicit
  2.  
  3. Function cpGet (ctl As Control, ByVal sKey As String) As Variant
  4. Dim EOR As String
  5. Dim lPos As Long
  6. Dim sTag As String
  7. Dim lPosNext As Long
  8.  
  9.    EOR = Chr$(26)
  10.  
  11.    sTag = ctl.Tag
  12.    lPos = InStr(sTag, sKey)
  13.  
  14.    If lPos = 0 Then
  15.       cpGet = ""
  16.  
  17.    Else
  18.       lPosNext = InStr(lPos, sTag, EOR)
  19.       If lPosNext = 0 Then lPosNext = Len(sTag) + 1
  20.  
  21.       lPos = lPos + Len(sKey) + 1
  22.  
  23.       cpGet = Mid$(sTag, lPos, lPosNext - lPos)
  24.    End If
  25. End Function
  26.  
  27. Function cpGetForm (frm As Form, ByVal sKey As String) As Variant
  28. Dim EOR As String
  29. Dim lPos As Long
  30. Dim sTag As String
  31. Dim lPosNext As Long
  32.  
  33.    EOR = Chr$(26)
  34.  
  35.    sTag = frm.Tag
  36.    lPos = InStr(sTag, sKey)
  37.  
  38.    If lPos = 0 Then
  39.       cpGetForm = ""
  40.  
  41.    Else
  42.       lPosNext = InStr(lPos, sTag, EOR)
  43.       If lPosNext = 0 Then lPosNext = Len(sTag) + 1
  44.  
  45.       lPos = lPos + Len(sKey) + 1
  46.  
  47.       cpGetForm = Mid$(sTag, lPos, lPosNext - lPos)
  48.    End If
  49. End Function
  50.  
  51.  
  52. Sub cpSet (ctl As Control, ByVal sKey As String, ByVal PropValue As Variant)
  53. Dim EOR As String
  54. Dim sValue As String
  55. Dim lPos As Long
  56. Dim sTag As String
  57. Dim lPosNext As Long
  58.  
  59.    EOR = Chr$(26)
  60.  
  61.    If IsNull(PropValue) Then
  62.       sValue = ""
  63.    Else
  64.       sValue = PropValue
  65.    End If
  66.    
  67. ' Make sure the new property value doesn't contain an embedded EOR
  68.    lPos = InStr(sValue, EOR)
  69.    If lPos Then
  70.       sValue = Left$(sValue, lPos)
  71.    End If
  72.  
  73. ' Search the Tag property for the key (include EOR and '=' to
  74. ' only match unique key value)
  75.    sTag = ctl.Tag
  76.    lPos = InStr(sTag, EOR & sKey & "=")
  77.  
  78.    ' New Property
  79.    If lPos = 0 Then
  80.       ' Don't add if value is empty
  81.       If sValue = "" Then
  82.          Exit Sub
  83.       End If
  84.       
  85.       sTag = sTag & EOR & sKey & "=" & sValue
  86.  
  87.    Else ' insert new value mid-string
  88.    ' find the end of this entry (beginning of right-hand Tag text to keep)
  89.       lPosNext = InStr(lPos + 1, sTag, EOR)
  90.       If lPosNext = 0 Then lPosNext = Len(sTag) + 1
  91.  
  92.    ' Point at end of left-hand Tag text to keep
  93.       lPos = lPos + Len(sKey) + 1
  94.  
  95.       sTag = Left$(sTag, lPos) & sValue & Mid$(sTag, lPosNext)
  96.    End If
  97.  
  98.    ctl.Tag = sTag
  99. End Sub
  100.  
  101. Sub cpSetForm (frm As Form, ByVal sKey As String, ByVal PropValue As Variant)
  102. Dim EOR As String
  103. Dim sValue As String
  104. Dim lPos As Long
  105. Dim sTag As String
  106. Dim lPosNext As Long
  107.  
  108.    EOR = Chr$(26)
  109.  
  110.    If IsNull(PropValue) Then
  111.       sValue = ""
  112.    Else
  113.       sValue = PropValue
  114.    End If
  115.    
  116. ' Make sure the new property value doesn't contain an embedded EOR
  117.    lPos = InStr(sValue, EOR)
  118.    If lPos Then
  119.       sValue = Left$(sValue, lPos)
  120.    End If
  121.  
  122. ' Search the Tag property for the key (include EOR and '=' to
  123. ' only match unique key value)
  124.    sTag = frm.Tag
  125.    lPos = InStr(sTag, EOR & sKey & "=")
  126.  
  127.    ' New Property
  128.    If lPos = 0 Then
  129.       ' Don't add if value is empty
  130.       If sValue = "" Then
  131.          Exit Sub
  132.       End If
  133.       
  134.       sTag = sTag & EOR & sKey & "=" & sValue
  135.  
  136.    Else ' insert new value mid-string
  137.    ' find the end of this entry (beginning of right-hand Tag text to keep)
  138.       lPosNext = InStr(lPos + 1, sTag, EOR)
  139.       If lPosNext = 0 Then lPosNext = Len(sTag) + 1
  140.  
  141.    ' Point at end of left-hand Tag text to keep
  142.       lPos = lPos + Len(sKey) + 1
  143.  
  144.       sTag = Left$(sTag, lPos) & sValue & Mid$(sTag, lPosNext)
  145.    End If
  146.  
  147.    frm.Tag = sTag
  148. End Sub
  149.  
  150.